home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu634.dms / pu634.adf / GENIES / Star.pdrx < prev    next >
Text File  |  1994-09-06  |  3KB  |  120 lines
  1. /*
  2. Copyright 1992 StarTeck. All rights reserved.
  3.  
  4. This Genie will create a star !!!
  5.                          starburst !!!
  6.                          triangle !!!
  7.                          square !!!
  8.                          inside-out star !!!
  9.                          pentagon !!!
  10.                          octagon !!!
  11.                          etc etc !!!
  12.    Just answer the prompts.
  13. */
  14. /* Trace ?results */
  15. call pdm_AutoUpdate(0)
  16. cr = '0a'x
  17.  
  18. numeric digits 5
  19.  
  20. msg = PDSetup.rexx(2,0) /* set-up librarys */
  21. units = getclip(pds_units)
  22. if msg ~= 1 then exit_msg(msg)
  23.  
  24. pi2 = 6.28318
  25.  
  26. call pdm_unselectobj()
  27.  
  28. /* Get input values */
  29. ODdefault = 1.000
  30. IDdefault = 0.382
  31. NPdefault = 5
  32.  
  33. OD = getclip(OutsideDiameter)
  34. ID = getclip(InsideDiameter)
  35. NP = getclip(NumberPoints)
  36.  
  37. if ~(OD = ODdefault & ID = IDdefault & NP = NPdefault) then do
  38.    if ~(OD = '' | ID = '' | NP = '') then do
  39.       DefLast = pdm_inform(3,'Input selection method...','DEFAULTS','Cancel','LAST USED')
  40.       if DefLast = 1 then exit_msg()
  41.       if DefLast = 0 then do
  42.          OD = ODdefault
  43.          ID = IDdefault
  44.          NP = NPdefault
  45.          end
  46.       end
  47.    end
  48.  
  49. IF OD = '' then OD = ODdefault
  50. IF ID = '' then ID = IDdefault
  51. IF NP = '' then NP = NPdefault
  52.  
  53. if units > 2 then OD = pdm_ConvertUnits(1,units,OD)
  54. if units > 2 then ID = pdm_ConvertUnits(1,units,ID)
  55.  
  56. prefsprompt = 'Outside Diameter:'OD ||cr|| ' Inside Diameter:'ID ||cr|| 'Number of Points:'NP
  57.  
  58. userprefs = pdm_getform('Input values...',7,prefsprompt)
  59.    if userprefs = '' then exit_msg()
  60.    parse var userprefs OD (cr) ID (cr) NP
  61.       if (OD = '') | (ID = '') | (NP = '') then exit_msg('Blank entry, re-run the Star Genie')
  62.       if ~(datatype(NP,n) & datatype(OD,n) & datatype(ID,n)) then exit_msg(Invalid entry...)
  63.       if NP < 2 then exit_msg('Number of points must be greater than 1...')
  64.  
  65. if units > 2 then OD = pdm_ConvertUnits(units,1,OD)
  66. if units > 2 then ID = pdm_ConvertUnits(units,1,ID)
  67.  
  68. call setclip(OutsideDiameter,OD)
  69. call setclip(InsideDiameter,ID)
  70. call setclip(NumberPoints,NP)
  71.  
  72. IR = ID/2
  73. OR = OD/2
  74.  
  75. /* Get center point */
  76. if OR > IR then
  77.    Largest = OR
  78. else
  79.    Largest = IR
  80.  
  81. center = PDM_clickellipse("Where do you want the center of the star?",Largest,Largest)
  82. if center = '' then exit_msg()
  83. xcenter = word(center,1)
  84. ycenter = word(center,2)
  85.  
  86. StartAngle = (pi2 / 4)
  87. increment  = ((pi2 / NP)/2)
  88. incrementangle = StartAngle
  89.  
  90. call pdm_InitPlot(xcenter,ycenter,1,1,0) /* initiate incremental start-point */
  91. call pdm_ShowStatus("Working...")
  92.  
  93.  
  94. do i = 1 to NP
  95.     x = cos(IncrementAngle) * IR
  96.     y = sin(IncrementAngle) * IR
  97.     call pdm_plotline(x" "y)
  98.  
  99.     incrementangle = incrementangle + increment
  100.     x = cos(IncrementAngle) * OR
  101.     y = sin(IncrementAngle) * OR
  102.     call pdm_plotline(x" "y)
  103.     incrementangle = incrementangle + increment
  104.    end /* do loop */
  105.  
  106. call pdm_ClosePlot()
  107.  
  108. exit_msg()
  109.  
  110.  
  111. exit_msg:
  112. do
  113.         parse arg message
  114.         if message ~= '' then
  115.             call pdm_Inform(1, message,)
  116.         call pdm_ClearStatus()
  117.         call pdm_SetUnits(units)
  118.         call pdm_AutoUpdate(1)
  119.         exit
  120. end